home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / Shrub / ProcessMsg.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-29  |  23KB  |  920 lines
  1. (*
  2.  * Shrub... HSPascal source
  3.  *
  4.  * ©Lee Kindness
  5.  *
  6.  * ProcessMsg.pas
  7.  *
  8.  *)
  9.  
  10. Procedure EnableMenuItems;
  11.  
  12. Begin
  13.     OnMenu(w, FULLMENUNUM(0, MN_SAVAS, 0));
  14.     OnMenu(w, FULLMENUNUM(0, MN_INFO, 0));
  15.     OnMenu(w, FULLMENUNUM(0, MN_PRINT, 0));
  16.     OnMenu(w, FULLMENUNUM(2, MN_FIND, 0));
  17.     OnMenu(w, FULLMENUNUM(2, MN_FINDNEXT, 0));
  18. End;
  19.  
  20. Procedure HandleResize(VAR w : pWindow);
  21.     
  22. Var
  23.     pos, Top : LONG;
  24.     t : Array[0..3] of tTagItem;
  25.     
  26. Begin
  27.     pos := RemoveGList(w, g[G_NI], -1);
  28.     if pos <> -1 then begin
  29.         EraseRect(w^.RPort, 0, 0, w^.Width, w^.Height);
  30.         arg.arg_Left    := w^.LeftEdge;
  31.         arg.arg_Top     := w^.TopEdge;
  32.         arg.arg_Width   := w^.Width;
  33.         arg.arg_Height := w^.Height;
  34.         
  35.         pos := 0;
  36.         if GadToolsBase^.lib_Version >= 39 then begin
  37.             T[0].ti_Tag  := GTLV_Top;
  38.             T[0].ti_Data := LONG(@Top);
  39.             T[1].ti_Tag  := TAG_END;
  40.             pos := GT_GetGadgetAttrsA(g[G_LV], w, NIL, @t);
  41.         End;
  42.         if pos = 0 then top := 0;
  43.         
  44.         FreeGadgets(g[G_NI]);
  45.         g[G_NI] := NIL;
  46.         G[G_CC] := CreateContext(@G[G_NI]);
  47.         If G[G_CC] <> NIL Then begin
  48.             T[0].ti_Tag  := GTLV_Top;
  49.             T[0].ti_Data := top;
  50.             t[1].ti_Tag  := GTLV_Labels;
  51.             t[1].ti_Data := LONG(th^.th_List);
  52.             T[2].ti_Tag  := GTLV_ShowSelected;
  53.             T[2].ti_Data := 0;
  54.             T[3].ti_Tag  := TAG_END;
  55.             With GadgetFlags Do Begin
  56.                 ng_TextAttr   := @My_Font;
  57.                 ng_LeftEdge   :=  8;
  58.                 ng_TopEdge    := S[TBS]+2;
  59.                 ng_Width      := Arg.arg_Width-ng_LeftEdge*2;
  60.                 ng_VisualInfo := vi;
  61.                 ng_Height     := Arg.arg_Height-ng_TopEdge-13;
  62.                 if GadToolsBase^.lib_Version < 39 then
  63.                     ng_Height := ng_Height - S[TBS];
  64.                 ng_GadgetText := NIL;
  65.                 ng_GadgetID   := G_LV;
  66.                 ng_Flags      := 0;
  67.             End;
  68.             G[G_LV] := CreateGadgetA(LISTVIEW_KIND, G[G_CC], @Gadgetflags, @T);
  69.  
  70.             pos := AddGList(w, g[G_NI], $FFFF, -1, NIL);
  71.             RefreshGList(g[G_NI], w, NIL, -1);
  72.             GT_RefreshWindow(w,NIL);
  73.             RefreshWindowFrame(w);
  74.         End;
  75.     End;
  76. End;
  77.  
  78.  
  79. Procedure EnableWindow(w : pWindow; key : Pointer);
  80.  
  81. Var
  82.     edw : pEnDisWin;
  83.  
  84. Begin
  85.     if pLibrary(SysBase)^.lib_Version >= 39 then begin
  86.         SetWindowPointerA(w, NIL);
  87.         edw := pEnDisWin(key);
  88.         If edw <> NIL then begin
  89.             if edw^.edw_Req <> NIL then begin
  90.                 EndRequest(edw^.edw_Req, w);
  91.                 if (edw^.edw_OldWidth <> w^.Width) or 
  92.                    (edw^.edw_OldHeight <> w^.Height) then { resize window }
  93.                     HandleResize(w);
  94.                 FreeVec(edw^.edw_Req);
  95.                 FreeVec(edw);
  96.             End;
  97.         End;
  98.     End else begin
  99.         if ReqToolsBase <> NIL then begin
  100.             if key <> NIL then begin
  101.                 rtUnLockWindow(w, Key);
  102.             End;
  103.         End;
  104.     End;
  105. End;
  106.  
  107. Function DisableWindow(w : pWindow) : Pointer;
  108.  
  109. Var
  110.     t : Array[0..4] of LONG;
  111.     req : pEnDisWin;
  112.  
  113. begin
  114.     DisableWindow := NIL;
  115.     if pLibrary(SysBase)^.lib_Version >= 39 then begin
  116.         t[0] := WA_BusyPointer;
  117.         t[1] := True_;
  118.         t[2] := WA_PointerDelay;
  119.         t[3] := True_;
  120.         t[4] := TAG_END;
  121.         SetWindowPointerA(w, @t);
  122.         req := AllocVec(sizeof(tEnDisWin), MEMF_CLEAR);
  123.         if req <> NIL then begin
  124.             req^.edw_Req := AllocVec(sizeof(tRequester), MEMF_CLEAR);
  125.             if req^.edw_req <> NIL then begin
  126.                 If Request(req^.edw_req, w) then begin
  127.                     req^.edw_OldWidth := w^.Width;
  128.                     req^.edw_OldHeight := w^.Height;
  129.                     DisableWindow := Pointer(req);
  130.                 end else begin
  131.                     FreeVec(req^.edw_Req);
  132.                     FreeVec(req);
  133.                 End;
  134.             End;
  135.         End;
  136.     End else begin
  137.         If ReqtoolsBase <> NIL then
  138.             DisableWindow := Pointer(rtLockWindow(w));
  139.     End;
  140. end;
  141.  
  142. Function WriteString(VAR f : BPTR; s : String) : Boolean;
  143. VAR
  144.     err : LONG;
  145.     
  146. begin
  147.     S := S+#10+#0; { add EOL and null term. }
  148.     err := FPuts(f,@s[1]);
  149.     if err = 0 then
  150.         WriteString := True
  151.     else
  152.         WriteString := False;
  153. End;
  154.  
  155. Procedure PrintAscii(filename : String; Print : Boolean; w : pWindow);
  156.  
  157. VAR
  158.     node    : pNode;
  159.     out     : BPTR;
  160.     dobj    : pDiskObject;
  161.     olddt,
  162.     thgs    : STRPTR;
  163.     daybuf, 
  164.     datebuf, 
  165.     buf     : String;
  166.     dt      : pDateTime;
  167.     ds      : pDateStamp;
  168.     Ok, Ok2 : Boolean;
  169.     y       : LONG;
  170.     ez      : pEasyStruct;
  171.     
  172. Begin
  173.     Ok := False;
  174.     out := Open(CStrConstPtrAR(@th^.th_RK, filename), MODE_NEWFILE);
  175.     if Out <> NULL then begin
  176.         If WriteString(out, '; Directory tree of "'+FExpandLock(th^.th_Loc)+'"') then begin
  177.             if WriteString(out, '; Created by Shrub ©Lee Kindness') then begin
  178.         
  179.                 ds := AllocVec(Sizeof(tDateStamp), MEMF_CLEAR);
  180.                 if ds <> NIL then begin
  181.                     ds := DateStamp(ds);
  182.                     dt := AllocVec(Sizeof(tDateTime), MEMF_CLEAR);
  183.                     if dt <> NIL then begin
  184.                         With dt^ do begin
  185.                             dat_Stamp   := ds^;
  186.                             dat_Format  := 4 {FORMAT_DEF};
  187.                             dat_StrDay  := @daybuf;
  188.                             dat_StrDate := @datebuf;
  189.                             dat_StrTime := @buf;
  190.                         End;
  191.                         If DateToStr(dt) then begin
  192.                             Ok := WriteString(out, '; Creation date: '+PtrToPas(@daybuf)+' '+
  193.                                                                        PtrToPas(@datebuf)+' '+
  194.                                                                        PtrToPas(@buf));
  195.                         End;
  196.                         FreeVec(dt);
  197.                     End;
  198.                     FreeVec(ds);
  199.                 End;
  200.                 
  201.                 If Ok then begin
  202.         
  203.                     if WriteString(out, '') then begin
  204.         
  205.                         if NOT ((numd = 0) and (numf = 0) and (tnumf = 0)) then begin 
  206.                             node := th^.th_List^.lh_Head;
  207.                             while (node^.ln_Succ <> NIL) and (Ok) do begin
  208.                                 Ok := WriteString(out,PtrToPas(node^.ln_Name));
  209.                                 node := node^.ln_Succ;
  210.                             End;
  211.                         End else
  212.                             Ok := WriteString(out, 'Directory is empty!');
  213.             
  214.                         if (NOT Print) and (Ok) then begin
  215.                             { save comment }
  216.                             Ok2 := SetComment(CStrConstPtrAR(@th^.th_RK, filename),
  217.                                 CStrConstPtrAR(@th^.th_RK, '"'+FExpandLock(th^.th_Loc)+'" Shrub ©Lee Kindness'));
  218.                             Ok2 := SetProtection(CStrConstPtrAR(@th^.th_RK, filename),
  219.                                 FIBF_EXECUTE);
  220.                         End;
  221.         
  222.                         if (arg.arg_SaveIcons) and (NOT Print) then begin
  223.                             dobj := GetDefDiskObject(WBPROJECT);
  224.                             if dobj <> NIL then begin
  225.                                 olddt := dobj^.do_DefaultTool;
  226.                                 dobj^.do_DefaultTool := CStrConstPtrAR(@th^.th_RK, 'SYS:Utilities/More');
  227.                                 filename := filename +#0;
  228.                                 OK2 := PutDiskObject(@filename[1], dobj);
  229.                                 dobj^.do_DefaultTool := olddt;
  230.                                 FreeDiskObject(dobj);
  231.                             End;
  232.                         End;
  233.                         If (print) and (Ok) then
  234.                             Ok := WriteString(out, ''#12); { write a formfeed character }
  235.                     End;
  236.                 End;
  237.             End;
  238.         End;
  239.         Ok2 := AmigaDos.Close_(out);
  240.     End;
  241.     If Ok = False then begin
  242.         ez := AllocVec(Sizeof(tEasyStruct), MEMF_CLEAR);
  243.         If ez <> NIL then begin
  244.             with ez^ do begin
  245.                 es_StructSize :=  Sizeof(tEasyStruct);
  246.                 es_Title := CStrConstPtrAR(@th^.th_RK, 'Shrub');
  247.                 if print then
  248.                     es_TextFormat := CStrConstPtrAR(@th^.th_RK,'Error Printing')
  249.                 else
  250.                     es_TextFormat := CStrConstPtrAR(@th^.th_RK,'Error Writing file:'#10+
  251.                                                                '%s');
  252.                 es_GadgetFormat := CStrConstPtrAR(@th^.th_RK,'Ok');
  253.             End;
  254.             y := Fault(IOErr, NIL, @buf, 256);
  255.             thgs := @buf;
  256.             y := EasyRequestArgs(w, ez, NIL, @thgs);
  257.             FreeVec(ez);
  258.         End;
  259.     End;
  260. End;
  261.  
  262. Procedure NewTree(w : pWindow; g :pGadget);
  263.     
  264. VAR
  265.     fr : pFileRequester;
  266.     t : Array[0..8] of LONG;
  267.     tl : BPTR;
  268.     Key : pWindow;
  269.  
  270. Begin
  271.     key := DisableWindow(w);
  272.     t[0] := ASLFR_TitleText;
  273.     t[1] := LONG(CStrConstPtrAR(@th^.th_RK, 'Select a directory for the tree'));
  274.     t[2] := ASLFR_Flags2;
  275.     t[3] := FRF_DRAWERSONLY|FRF_REJECTICONS;
  276.     t[4] := ASLFR_InitialDrawer;
  277.     t[5] := LONG(CStrConstPtrAR(@th^.th_RK, cdir));
  278.     t[6] := ASLFR_Window;
  279.     t[7] := LONG(w);
  280.     t[8] := TAG_DONE;
  281.  
  282.     fr := AllocASLRequest(ASL_FileRequest, @t);
  283.     if fr <> NIL then begin
  284.         if AslRequest(fr, NIL) then begin
  285.         
  286.             { detach list }
  287.             t[0] := GTLV_Labels;
  288.             t[1] := $FFFFFFFF;
  289.             t[2] := TAG_END;
  290.             GT_SetGadgetAttrsA(g, w, NIL, @t);
  291.             
  292.             tl := Lock(STRPTR(fr^.fr_Drawer), ACCESS_READ);
  293.             if tl <> NULL then begin
  294.                 wintitle := 'Freeing Tree...'#0;
  295.                 SetWindowTitles(w, @wintitle[1], STRPTR(-1));
  296.                 FreeTree(th);
  297.                 wintitle := 'CreatingTree...'#0;
  298.                 SetWindowTitles(w, @wintitle[1], STRPTR(-1));
  299.                 th := AllocTree(th);
  300.                 if th = NIL then Halt;
  301.                 th^.th_Loc := tl;
  302.                 If Empty then
  303.                     EnableMenuItems(w);
  304.                 CreateTree(th, True);
  305.             End;
  306.             
  307.             cdir := PtrToPas(STRPTR(fr^.fr_Drawer));
  308.             
  309.             { attach list }
  310.             t[0] := GTLV_Labels;
  311.             t[1] := LONG(th^.th_List);
  312.             t[2] := TAG_END;
  313.             GT_SetGadgetAttrsA(g, w, NIL, @t);
  314.             
  315.             wintitle := 'Tree for "' + cdir + '"'#0;
  316.             scrtitle := DEFTITLE + #0;
  317.             SetWindowTitles(w, @wintitle[1], @scrtitle[1]); 
  318.         end;
  319.         FreeAslRequest(fr);
  320.     End;
  321.     EnableWindow(w, Key);
  322. End;
  323.  
  324.  
  325. Procedure SaveAs(w : pWindow);
  326.     
  327. VAR
  328.     fr      : pFileRequester;
  329.     t       : Array[0..10] of LONG;
  330.     buf     : String[255];
  331.     key     : Pointer;
  332.     fullname,
  333.     dir, ext,
  334.     name,
  335.     cfile   : String;
  336.     
  337. Const
  338.     cdir : String[80] = 'RAM:';
  339.  
  340. Begin
  341.     if NOT empty then begin
  342.         key := DisableWindow(w);
  343.         
  344.         fullname := FExpandLock(th^.th_Loc);
  345.         FSplit(fullname, dir, name, ext);
  346.         cfile := name+'.tree';
  347.         
  348.         t[0] := ASLFR_TitleText;
  349.         t[1] := LONG(CStrConstPtrAR(@th^.th_RK, 'Select a file'));
  350.         t[2] := ASLFR_InitialDrawer;
  351.         t[3] := LONG(CStrConstPtrAR(@th^.th_RK, cdir));
  352.         t[4] := ASLFR_InitialFile;
  353.         t[5] := LONG(CStrConstPtrAR(@th^.th_RK, cfile));
  354.         t[6] := ASLFR_Flags1;
  355.         t[7] := FRF_DOSAVEMODE;
  356.         t[8] := ASLFR_Window;
  357.         t[9] := LONG(w);
  358.         t[10] := TAG_DONE;
  359.         fr := AllocASLRequest(ASL_FileRequest, @t);
  360.         if fr <> NIL then begin
  361.             if AslRequest(fr, NIL) then begin
  362.                 cdir := PtrToPas(STRPTR(fr^.fr_Drawer));
  363.                 cfile := PtrToPas(STRPTR(fr^.fr_File));
  364.                 buf := cdir + #0;
  365.                 If AddPart(@buf[1],STRPTR(fr^.fr_File), 255) then begin
  366.                     buf := PtrToPas(@buf[1]);
  367.                     PrintAscii(buf, false, w);
  368.                 End; 
  369.             end;
  370.             FreeAslRequest(fr);
  371.         End;
  372.         EnableWindow(w, key);
  373.     End else DisplayBeep(NIL);
  374. End;
  375.  
  376. Function UpperStr(s : String) : String;
  377. Var
  378.      X : Byte;
  379. Begin
  380.   For X := 1 To Length(S) Do
  381.     S[X] := UpCase(S[X]);
  382.   UpperStr := S;
  383. End;
  384.  
  385. Function StripN(nd : pmn): String;
  386.  
  387. Var
  388.     StartPos : Integer;
  389.  
  390. begin
  391.     startpos := 1;
  392.     if nd^.ln_NumSTxt <> 0 then
  393.         startpos := Length(arg.arg_STxt) * nd^.ln_NumSTxt +1;
  394.         
  395.     StripN := Copy(PtrToPas(nd^.ln_Name), startpos, nd^.ln_AbsNameSize);
  396. End;
  397.  
  398.  
  399. Procedure RebuildPath(node : pmn; VAR name : String);
  400.  
  401. Var
  402.     csts : Integer;
  403.     n2     : pmn;
  404.     
  405. Begin
  406.     { rebuild the path }
  407.     n2 := node^.ln_Pred;
  408.     ok := True;
  409.     csts := node^.ln_NumSTxt;
  410.     while (n2^.ln_Pred <> NIL) and (Ok) do begin
  411.         if n2^.ln_DirEntryType > 0 then begin
  412.             if n2^.ln_NumStxt < csts then begin
  413.                 csts := n2^.ln_NumStxt;
  414.                  name := StripN(n2) + '/' + Name;
  415.              End;
  416.         End;
  417.         if n2^.ln_NumSTxt = 0 then
  418.             Ok := False;
  419.         n2 := n2^.ln_Pred;
  420.     End;
  421. End;
  422.  
  423. Procedure ExecAsynch(filename : String);
  424.  
  425. VAR
  426.     t       : Array[0..3] of tTagItem;
  427.     outfile : BPTR;
  428.     rc      : LONG;
  429.     ok      : Boolean;
  430.  
  431. CONST
  432.     Out : String[5] = 'NIL:'#0;
  433.     
  434. Begin
  435.     filename := arg.arg_Viewer + ' "' + filename + '"'#0;
  436.     { open IO file }
  437.     outfile := Open(@out[1], MODE_OLDFILE);
  438.     { Start program }
  439.     t[0].ti_Tag  := SYS_ASynch;
  440.     t[0].ti_Data := True_;
  441.     t[1].ti_Tag  := SYS_Input;
  442.     t[1].ti_Data := outfile;
  443.     t[2].ti_Tag  := SYS_Output;
  444.     t[2].ti_Data := 0;
  445.     t[3].ti_Tag  := TAG_END;
  446.     rc := SystemTagList(@filename[1], @t);
  447.     If rc <> 0 then Begin
  448.         If rc = -1 Then
  449.             ok := Close_(outfile);
  450.         DisplayBeep(NIL);
  451.     End;
  452. End;
  453.  
  454.     
  455. Procedure ViewAction(w : pWindow; node : pmn; action : LONG);
  456.  
  457. Var
  458.     FinalName, FinalNameNN, Name, DirPart, ext : String;
  459.     l  : BPTR;
  460.     Ok : Boolean;
  461.     n  : LONG;
  462.  
  463. Begin
  464.     If node <> NIL Then Begin
  465.         { Strip white space and other junk }
  466.         Name := StripN(node);
  467.         { rebuild to complete path from starting dir }
  468.         RebuildPath(node, Name);
  469.         { rebuild the FULL path }
  470.         FinalName := FExpandLock(th^.th_Loc);
  471.         FinalName := FinalName+#0;
  472.         Name := Name + #0;
  473.         Ok := AddPart(@FinalName[1], @Name[1], 255);
  474.         FinalName := PtrToPas(@FinalName[1]);
  475.         { Split full path into separate bits }
  476.         FSplit(FinalName, DirPart, Name, ext);
  477.         { Null terminate each and join if required }
  478.         Name := Name + ext + #0;
  479.         DirPart := DirPart + #0;
  480.         FinalNameNN := FinalName;
  481.         FinalName := FinalName + #0;
  482.  
  483.         l := Lock(@DirPart[1], ACCESS_READ);
  484.         if l <> NULL then begin
  485.             Case Action Of
  486.                 VIEW_ACTION_INFO : If WorkBenchBase^.lib_Version >= MININFOVER then
  487.                     n := WBInfo(l, @Name[1], w^.WScreen)
  488.                 else
  489.                     DisplayBeep(NIL);
  490.                 VIEW_ACTION_SHOW : ExecASynch(FinalNameNN);
  491.             End;
  492.             UnLock(l);
  493.         End Else
  494.             DisplayBeep(NIL);
  495.     End Else
  496.         DisplayBeep(NIL);
  497. End;
  498.  
  499.  
  500. Procedure HandleSearch(w : pWindow; mode : LONG);
  501.     
  502. Var
  503.     SearchNode, 
  504.     node2 : pmn;
  505.     rk    : pRemember;
  506.     t     : Array[0..6] Of LONG;
  507.     key   : Pointer;
  508.     n     : Integer;
  509.     CurNodeText : String;
  510.     ret   : LONG;
  511.     cont  : Boolean;
  512.     ez    : pEasyStruct;
  513.     
  514. Begin
  515.     rk := NIL;
  516.     Key := DisableWindow(w);
  517.     
  518.     If (cnode = NIL) Then
  519.         SearchNode := pmn(th^.th_List^.lh_Head)
  520.     else begin
  521.         SearchNode := cnode;
  522.         If (searchnode^.ln_Succ^.ln_Succ <> NIL) Then
  523.             SearchNode := SearchNode^.ln_Succ;
  524.     End;
  525.     
  526.     If NOT ValidPattern Then
  527.         buf := ''#0;
  528.     
  529.     { get search text }
  530.     If mode = FIND_ITEM Then Begin
  531.         ValidPattern := False;
  532.         t[0] := RTGS_TextFmt;
  533.         t[1] := LONG(CStrConstPtrAR(@rk, 'Enter the text to search for below.'#10+
  534.                                          'Standard wildcards are supported.'));
  535.         t[2] := RTGS_Flags;
  536.         t[3] := GSREQF_CENTERTEXT;
  537.         t[4] := TAG_END;
  538.         ret := rtGetStringA(@buf[1], 250, CStrConstPtrAR(@rk, 'Enter Search String'),
  539.                             NIL, @t);
  540.         If ret = True_ Then Begin
  541.             SearchText := '#?' + PtrToPas(@buf[1]) + '#?'#0;
  542.             If pLibrary(DosBase)^.lib_Version < 39 then
  543.                 searchtext := UpperStr(searchtext); { V37 dos character classes workaround }
  544.             { parse the pattern }
  545.             If ParsePatternNoCase(CStrConstPtrAR(@th^.th_RK, SearchText), @SKey, 514) <> -1 then
  546.                 ValidPattern := True;
  547.         End;
  548.     End Else
  549.         ret := True_;
  550.     
  551.     If ret = True_ Then Begin
  552.         cont := True;
  553.         while (SearchNode^.ln_Succ <> NIL) and (cont) do begin
  554.             curnodetext := StripN(SearchNode) + #0;
  555.             If MatchPatternNoCase(@SKey, @curnodetext[1]) then begin
  556.                 cont := False;
  557.                 cnode := SearchNode;
  558.                 n := 0;
  559.                 node2 := pmn(th^.th_List^.lh_Head);
  560.                 While node2 <> SearchNode Do Begin
  561.                     node2 := node2^.ln_Succ;
  562.                     inc(n);
  563.                 End;
  564.                 T[0] := GTLV_Selected;
  565.                 T[1] := n;
  566.                 T[2] := GTLV_Top;
  567.                 If n > 2 then
  568.                     T[3] := n-2
  569.                 Else
  570.                     T[3] := 0;
  571.                 T[4] := GTLV_MakeVisible;
  572.                 T[5] := n;
  573.                 T[6] := TAG_END;
  574.                 GT_SetGadgetAttrsA(g[G_LV], w, NIL, @t);
  575.                 
  576.             End else
  577.                 SearchNode := SearchNode^.ln_Succ;
  578.         End;
  579.         If SearchNode^.ln_Succ = NIL Then Begin
  580.             ez := AllocVec(Sizeof(tEasyStruct), MEMF_CLEAR);
  581.             If ez <> NIL Then Begin
  582.                 With ez^ Do Begin
  583.                     es_StructSize := Sizeof(tEasyStruct);
  584.                     es_Title := CStrConstPtrAR(@rk, 'Search');
  585.                     es_TextFormat := CStrConstPtrAR(@rk, 'No more matches found.');
  586.                     es_GadgetFormat := CStrConstPtrAR(@rk, 'Ok');
  587.                     ret := EasyRequestArgs(w, ez, NIL, NIL);
  588.                 End;
  589.                 FreeVec(ez);
  590.             End;
  591.         End;
  592.     End;
  593.     FreeRemember(@rk, True);
  594.     EnableWindow(w,key);
  595. End;
  596.     
  597.  
  598.  
  599. Procedure HandleMenu(w: pWindow; MenuNumber : Word; Var Exitflag : Boolean);
  600.  
  601. Var
  602.     y, INum, MNum : Word;
  603.     item          : pMenuItem;
  604.     ez            : pEasyStruct;
  605.     key           : Pointer;
  606.     
  607. Begin
  608.     While (menunumber <> MENUNULL) and (ExitFlag = False) do begin
  609.         item := ItemAddress(menustrip, menunumber);
  610.         Case LONG(GTMENUITEM_USERDATA(item)) of 
  611.             M_DIR  : NewTree(w, G[G_LV]);
  612.             M_SAVE : SaveAs(w);
  613.             M_INFO : if NOT empty then begin
  614.                 key := DisableWindow(w);
  615.                 ez := AllocRemember(@grk, Sizeof(tEasyStruct), MEMF_CLEAR);
  616.                 if ez <> NIL then begin
  617.                     With ez^ do begin
  618.                         es_StructSize :=  Sizeof(tEasyStruct);
  619.                         es_Title := CStrConstPtrAR(@grk, 'Shrub Stastistics');
  620.                         if (numd = 0) and (numf = 0) and (tnumf = 0) then
  621.                             es_TextFormat := CStrConstPtrAR(@grk,
  622.                                 'Directory "%s" is empty')
  623.                         Else
  624.                             es_TextFormat := CStrConstPtrAR(@grk,
  625.                                 'Directory "%s"'#10+
  626.                                 '%ld drawers'#10+
  627.                                 '%ld files shown out of %ld possible');
  628.                         es_GadgetFormat := CStrConstPtrAR(@grk, 'Ok');
  629.                     End;
  630.                     al[0] := LONG(CStrConstPtrAR(@th^.th_RK, FExpandLock(th^.th_Loc)));
  631.                     al[1] := numd;
  632.                     al[2] := numf;
  633.                     al[3] := tnumf;
  634.                     y := EasyRequestArgs(w, ez, NIL, @al);
  635.                 end;
  636.                 EnableWindow(w, key);
  637.             end else DisplayBeep(NIL);
  638.             M_PRINT : if NOT empty then begin
  639.                 key := DisableWindow(w);
  640.                 PrintAscii('PRT:', True, w);
  641.                 EnableWindow(w, key);
  642.             End else DisplayBeep(NIL);
  643.             M_ABOUT : Begin
  644.                 key := DisableWindow(w);
  645.                 ez := AllocRemember(@th^.th_RK, Sizeof(tEasyStruct), MEMF_CLEAR);
  646.                 if ez <> NIL then begin
  647.                     With ez^ do begin
  648.                         es_StructSize :=  Sizeof(tEasyStruct);
  649.                         es_Title := CStrConstPtrAR(@th^.th_RK, 'Shrub Information');
  650.                         es_TextFormat := CStrConstPtrAR(@th^.th_RK,
  651.                             'Shrub Copyright ©Lee Kindness.'#10+
  652.                             '%s'#10+
  653.                             ''#10+
  654.                             'If you can''t find the roots then the shrub must be dead...'#10+
  655.                             'Read "Shrub.Guide" for more information'#10+
  656.                             ''#10+
  657.                             'Comments to:'#10+
  658.                             ' Lee Kindness'#10+
  659.                             ' 8 Craigmarn Road'#10+
  660.                             ' Portlethen Village'#10+
  661.                             ' Aberdeen AB1 4QR'#10+
  662.                             ' SCOTLAND'#10);
  663.                         es_GadgetFormat := CStrConstPtrAR(@th^.th_RK, 'Ok');
  664.                     End;
  665.                     al[0] := LONG(@ves[6]);
  666.                     y := EasyRequestArgs(w, ez, NIL, @al);
  667.                 end;
  668.                 EnableWindow(w, key);
  669.             end;
  670.             M_SHOWDC : ViewAction(w, cnode, VIEW_ACTION_SHOW);
  671.             M_INFODC : ViewAction(w, cnode, VIEW_ACTION_INFO);
  672.             M_FIND : HandleSearch(w, FIND_ITEM);
  673.             M_FINDNEXT : If ValidPattern Then HandleSearch(w, FIND_NEXTITEM);
  674.             M_QUIT : ExitFlag := True;
  675.             M_SHOW : begin
  676.                 if (item^.Flags and CHECKED) <> 0 then
  677.                     arg.arg_ShowIcons := True
  678.                 else
  679.                     arg.arg_ShowIcons := False;
  680.             End;
  681.             M_SICO : begin
  682.                 if (item^.Flags and CHECKED) <> 0 then
  683.                     arg.arg_SaveIcons := True
  684.                 else
  685.                     arg.arg_SaveIcons := False;
  686.             End;
  687.             M_FLD : begin
  688.                 if (item^.Flags and CHECKED) <> 0 then
  689.                     arg.arg_fld := True
  690.                 else
  691.                     arg.arg_fld := False;
  692.             End;
  693.             M_SODC : begin
  694.                 if (item^.Flags and CHECKED) <> 0 then
  695.                     arg.arg_ShowODC := True
  696.                 else
  697.                     arg.arg_ShowODC := False;
  698.             End;
  699.             M_IODC : begin
  700.                 if (item^.Flags and CHECKED) <> 0 then
  701.                     arg.arg_InfoODC := True
  702.                 else
  703.                     arg.arg_InfoODC := False;
  704.             End;
  705.         End;
  706.         menunumber := item^.NextSelect;
  707.     end;
  708. end;
  709.  
  710. Procedure HandleLV(w : pWindow; node : pmn);
  711.  
  712. Var
  713.     t        : Array[0..2] of LONG;
  714.     key      : pWindow;
  715.     n        : LONg;
  716.     l, tmplock, odir        : BPTR;
  717.     name, finalname, dirpart, ext, titletext     : String;    
  718.     
  719. Begin
  720.     key := DisableWindow(w);
  721.     { detach list }
  722.     t[0] := GTLV_Labels;
  723.     t[1] := $FFFFFFFF;
  724.     t[2] := TAG_END;
  725.     GT_SetGadgetAttrsA(g[G_LV], w, NIL, @t);
  726.  
  727.     name := StripN(node);
  728.     
  729.     RebuildPath(node, name);
  730.     
  731.     FinalName := FExpandLock(th^.th_Loc);
  732.     finalname := finalname+#0;
  733.     name := name + #0;
  734.     Ok := AddPart(@finalname[1], @name[1], 255);
  735.     finalname := PtrToPas(@finalName[1]);
  736.     
  737.     FSplit(finalname, dirpart, name, ext);
  738.     name := name+ext;
  739.         
  740.     titleText := '';
  741.     if Pos('l>', PtrToPas(node^.ln_Name)) <> 0 then begin
  742.         tmplock := Lock(CStrConstPtrAR(@th^.th_RK, finalname), ACCESS_READ);
  743.         if tmplock <> NULL then begin
  744.             Case node^.ln_DirEntryType Of
  745.                 ST_SOFTLINK : TitleText := 'soft link to';
  746.                 ST_LINKFILE : TitleText := 'hard file link to';
  747.                 ST_LINKDIR  : TitleText := 'hard drawer link to';
  748.                 Else TitleText := '';
  749.             End;
  750.             titleText := '"'+finalname+'" '+TitleText+' "'+FExpandLock(tmplock)+'"';
  751.             UnLock(tmplock);
  752.         End;
  753.     End else begin
  754.         titletext := '"'+finalname+'"';
  755.     End;
  756.     scrtitle := titletext + #0;
  757.     SetWindowTitles(w, STRPTR(-1), @scrtitle[1]);
  758.     
  759.     if pos('.INFO',UpperStr(finalname)) = 0 then begin
  760.         l := Lock(CStrConstPtrAR(@th^.th_RK, dirpart), ACCESS_READ);
  761.         if l <> NULL then begin
  762.             if arg.arg_InfoODC then begin
  763.                 if WorkBenchBase^.lib_Version >= MININFOVER then
  764.                     n := WBInfo(l, CStrConstPtrAR(@th^.th_RK, name), w^.WScreen)
  765.                 else
  766.                     DisplayBeep(NIL);
  767.             End;
  768.                 
  769.             if arg.arg_ShowODC then begin
  770.                 ExecASynch(finalname)
  771.             End;
  772.             
  773.             UnLock(l);
  774.         End else
  775.             DisplayBeep(NIL);
  776.         
  777.     End else
  778.         DisplayBeep(NIL);
  779.             
  780.     { attach list }
  781.     t[0] := GTLV_Labels;
  782.     t[1] := LONG(th^.th_List);
  783.     t[2] := TAG_END;
  784.     GT_SetGadgetAttrsA(g[G_LV], w, NIL, @t);
  785.     
  786.     EnableWindow(w, Key);
  787. End;
  788.     
  789.  
  790.  
  791. Procedure HandleGadget(w : pWindow; gadcode : pGadget; num : LONG);
  792.  
  793. Var
  794.     node : pmn;
  795.     n : Integer;
  796.     
  797. Begin       
  798.     Case gadcode^.GadgetID Of 
  799.         G_DIR : NewTree(w, G[G_LV]);
  800.         G_LV  : begin
  801.             node := pmn(th^.th_List^.lh_Head);
  802.             For n := 1 to num do begin
  803.                 node := node^.ln_Succ;
  804.             End;
  805.             cnode := node;
  806.             If cnode^.ln_Succ <> NIL Then 
  807.             
  808.             If DoubleClick(oldsecs, oldmics, secs, mics) then begin
  809.                 HandleLV(w, node);
  810.                 oldsecs := 0;
  811.                 oldmics := 0;
  812.             End else begin
  813.                 oldsecs := secs;
  814.                 oldmics := mics;
  815.             End;
  816.         End;
  817.     End;
  818. End;
  819.  
  820.  
  821. Procedure RefreshTheWindow(w : pWindow);
  822.  
  823. begin
  824.     GT_BeginRefresh(w);
  825.     GT_EndRefresh(w, True);
  826. end;
  827.  
  828. Procedure HandleAppWin(VAR args : pWBArg; g : pGadget; w : pWindow);
  829.  
  830. Var
  831.     t : Array[0..2] of LONG;
  832.     key : pWindow; 
  833.     
  834. Begin
  835.     key := DisableWindow(w);
  836.     { detach list }
  837.     t[0] := GTLV_Labels;
  838.     t[1] := $FFFFFFFF;
  839.     t[2] := TAG_END;
  840.     GT_SetGadgetAttrsA(g, w, NIL, @t);
  841.     
  842.     If args^.wa_Lock <> NULL then begin
  843.         wintitle := 'Freeing Tree...'#0;
  844.         SetWindowTitles(w, @wintitle[1], STRPTR(-1));
  845.         FreeTree(th);
  846.         wintitle := 'Creating Tree...'#0;
  847.         SetWindowTitles(w, @wintitle[1], STRPTR(-1));
  848.         th := AllocTree(th);
  849.         if th = NIL then Halt;
  850.         th^.th_Loc := DupLock(args^.wa_Lock);
  851.         If Empty then
  852.             EnableMenuItems(w);
  853.         CreateTree(th, True);
  854.         cdir := FExpandLock(th^.th_Loc);
  855.         wintitle := 'Tree for "' + cdir + '"'#0;
  856.         SetWindowTitles(w, @wintitle[1], STRPTR(-1));
  857.     End;
  858.             
  859.     { attach list }
  860.     t[0] := GTLV_Labels;
  861.     t[1] := LONG(th^.th_List);
  862.     t[2] := TAG_END;
  863.     GT_SetGadgetAttrsA(g, w, NIL, @t);
  864.     
  865.     EnableWindow(w, Key);
  866. End;
  867.  
  868.  
  869. Procedure ProcessWindowEvents;
  870.  
  871. CONST
  872.     Exitflag : Boolean = False;
  873.     
  874. VAR 
  875.     message         : pIntuiMessage;
  876.     MsgClass, sigre,
  877.     AppMask, WinMask: LONG;
  878.     MsgCode         : Word;
  879.     Gadcode         : pGadget;
  880.     am              : pAppMessage;
  881.     ez              : pEasyStruct;
  882.  
  883. begin
  884.     AppMask := BitMask(AppPort^.MP_SIGBIT);
  885.     WinMask := BitMask(w^.UserPort^.MP_SIGBIT);
  886.     While Not exitflag Do Begin
  887.         sigre    := Wait(AppMask|WinMask);
  888.         if ((sigre and AppMask)=AppMask) then begin
  889.             { message from the appwindow }
  890.             am := pAppMessage(GetMsg(AppPort));
  891.             while am <> NIL do begin
  892.                 If am^.am_ArgList <> NIL then begin
  893.                     HandleAppWin(am^.am_ArgList, G[G_LV], w);
  894.                 End;
  895.                 ReplyMsg(pMessage(am));
  896.                 am := pAppMessage(GetMsg(AppPort));
  897.             End;
  898.         End;
  899.         
  900.         if ((sigre and WinMask)=WinMask) then begin
  901.             message  := GT_GetIMsg(w^.userPort);
  902.             while message <> NIL do begin
  903.                 MsgClass := message^.Class;
  904.                 MsgCode  := message^.Code;
  905.                 GadCode  := pGadget(message^.IAddress);
  906.                 secs     := Message^.Seconds;
  907.                 mics     := Message^.Micros;    
  908.                 GT_ReplyIMsg(message);
  909.                 Case MsgClass Of
  910.                     IDCMP_CLOSEWINDOW   : ExitFlag := True;
  911.                     IDCMP_REFRESHWINDOW : RefreshTheWindow(w);
  912.                     IDCMP_MENUPICK      : HandleMenu(w, msgcode, exitflag);        
  913.                     IDCMP_GADGETUP      : HandleGadget(w, gadcode, msgcode);
  914.                     IDCMP_NEWSIZE       : HandleResize(w);
  915.                 End;
  916.                 message  := GT_GetIMsg(w^.userPort);
  917.             End;
  918.         end;
  919.     End; {while}
  920. end;